home *** CD-ROM | disk | FTP | other *** search
/ MacHack 1997 / MacHack 1997.toast / Hacks / Hacks ’93 / Jon’s FKEYs / FreeRAM ƒ / FreeRAM FKEY2.p < prev    next >
Text File  |  1992-11-14  |  5KB  |  193 lines
  1. {    FreeRAM FKEY © 1989-90 by Jon Wind                                                            }
  2. {    Version 1.1 on 12/25/90                                                                            }
  3. {    Version 1.2 on 9/20/92                                                                                }
  4. {    Version 1.3 on 11/14/92                                                                            }
  5.  
  6. {    This FKEY displays the amount of Free RAM in the upper left of the menu bar.  Click            }
  7. {    or press a key to restore menu bar.  If the Caps Lock key is down, the current heap            }
  8. {    will be compacted and purge all purgeable blocks.  If executed on a machine running            }
  9. {    in color, the current menu colors will be used to display the information.                        }
  10.  
  11. {     Thanks to Brad Pettit and his colorfkey for his method of conditional compilation.                }
  12.  
  13. {    To execute this as a program...                                                                        }
  14. {        1. change the definition of fkey to false                                                        }
  15. {        2. set the project type to application                                                            }
  16. {        3. change the library from drvrruntime.lib to µruntime.lib                                    }
  17. {        4. rebuild the project                                                                            }
  18.  
  19.  
  20. {$setc fkey := true}
  21.  
  22. {$ifc fkey}
  23.  
  24. unit FreeRAMFKEY;
  25.  
  26. interface
  27.  
  28.     procedure main;
  29.  
  30. implementation
  31.  
  32. {$elsec}
  33.  
  34.     program FreeRAMFKEY;
  35.  
  36. {$endc}
  37.  
  38.         procedure main;
  39.             const
  40.                 Vers = 'v1.3';
  41.                 bCommandKey = 48;
  42.                 bShiftKey = 63;
  43.                 bControlKey = 60;
  44.                 bOptionKey = 61;
  45.                 bCapsLockKey = 62;
  46.                 WaitTime = 45;
  47.             type
  48.                 myScrapRec = record
  49.                         kind: ResType;
  50.                         offset: LongInt;
  51.                     end;
  52.                 myScrapRecPtr = ^myScrapRec;
  53.                 myScrapRecHdl = ^myScrapRecPtr;
  54.             var
  55.                 menuRect: Rect;
  56.                 savePort: GrafPtr;
  57.                 CMenuPtr: MCEntryPtr;
  58.                 usingColor: Boolean;
  59.                 p: grafport;
  60.                 theEvent: EventRecord;
  61.                 MemSize: LongInt;
  62.                 ScrapInfo: pScrapStuff;
  63.                 theErr: OSErr;
  64.                 thePtr: Ptr;
  65.                 theFont, baseLine, menuHeight: Integer;
  66.                 fInfo: FontInfo;
  67.  
  68.  
  69.             function GetMBarHeight: Integer;
  70.     { get current menu bar height }
  71.                 var
  72.                     thePtr: ^Integer;
  73.             begin
  74.                 thePtr := Pointer($BAA);
  75.                 GetMBarHeight := thePtr^;
  76.             end;  { of func GetMBarHeight }
  77.  
  78.             function aNum2Str (aNum: LongInt): Str255;
  79.     { NumToString procedure available as a function }
  80.                 var
  81.                     NumStr: Str255;
  82.             begin
  83.                 NumToString(aNum, NumStr);
  84.                 aNum2Str := NumStr;
  85.             end;
  86.  
  87.             function GetKeyDown (index: Integer): Boolean;
  88.     { return the state of the desired key - true if down; false if up }
  89.                 var
  90.                     keys: keymap;
  91.             begin
  92.                 GetKeys(keys);
  93.                 GetKeyDown := bittst(@keys, index);        { look at entry within the key map }
  94.             end;
  95.  
  96.             function IsColor: Boolean;
  97.     { return true if using 16 or more "colors" }
  98.                 var
  99.                     maindevice: GDHandle;
  100.                     theWorld: SysEnvRec;
  101.             begin
  102.                 IsColor := False;
  103.                 if (SysEnvirons(1, theWorld) <> envNotPresent) then    { SysEnvirons call available? }
  104.                     if theWorld.hasColorQD then        { has Color QuickDraw }
  105.                         begin
  106.                             maindevice := GetMainDevice;
  107.                             IsColor := (maindevice^^.gdPMap^^.pixelsize > 2);        { 16 or more shades? }
  108.                         end;
  109.             end;{ of func IsColor }
  110.  
  111.  { --------- Main Procedure --------- }
  112.         begin
  113.             GetPort(savePort);            { save current grafport }
  114.  
  115.             usingColor := IsColor;
  116.             if usingcolor then
  117.                 begin
  118.                     OpenCPort(@p);            { open as current port }
  119.                     CMenuPtr := GetMCEntry(0, 0);
  120.                     if CMenuPtr <> nil then
  121.                         begin
  122.                             RGBForeColor(CMenuPtr^.mctRGB1);
  123.                             RGBBackColor(CMenuPtr^.mctRGB4);
  124.                         end;
  125.                 end
  126.             else
  127.                 OpenPort(@p);                { open as current port }
  128.  
  129.             GetFNum('Geneva', theFont);
  130.             TextFont(theFont);
  131.             TextSize(9);
  132.             GetFontInfo(fInfo);
  133.             menuHeight := GetMBarHeight;
  134.             baseLine := Pred(((menuHeight - (fInfo.ascent + fInfo.descent)) div 2) + fInfo.ascent);
  135.             SetRect(menuRect, 1, 0, p.portrect.right, menuHeight - 1);
  136.             EraseRoundRect(menuRect, 12, 12);
  137.  
  138.             MoveTo(menuRect.right - StringWidth(Vers) - 5, menuRect.bottom - 5);
  139.             DrawString(Vers);
  140.  
  141.             TextFace([bold]);
  142.             Moveto(35, baseLine);
  143.  
  144.             if GetKeyDown(bCapsLockKey) then        { test for caps lock down }
  145.                 begin
  146.                     PurgeMem(maxSize);
  147.                     MemSize := CompactMem(maxSize);
  148.                 end;
  149.  
  150.             DrawString(Concat(aNum2Str(FreeMem), ' bytes (', aNum2Str((FreeMem + 512) div 1024), 'K) free in current Heap'));
  151.             TextFace([]);
  152.  
  153.             theErr := LoadScrap;
  154.             ScrapInfo := InfoScrap;
  155.             if ScrapInfo^.scrapSize > 0 then
  156.                 begin
  157.                     HLock(ScrapInfo^.ScrapHandle);
  158.                     thePtr := Pointer(Ord4(scrapinfo^.scraphandle^));
  159.                     DrawString(Concat('; ', aNum2Str(ScrapInfo^.scrapSize), ' ['));
  160.                     repeat
  161.                         if Ord4(thePtr) <> Ord4(scrapinfo^.scraphandle^) then
  162.                             DrawString(',');
  163.                         DrawString(myScrapRecPtr(thePtr)^.kind);
  164.                         if Odd(myScrapRecPtr(thePtr)^.offset) then
  165.                             myScrapRecPtr(thePtr)^.offset := Succ(myScrapRecPtr(thePtr)^.offset);
  166.                         thePtr := Pointer(Ord4(thePtr) + SizeOf(myScrapRec) + myScrapRecPtr(thePtr)^.offset);
  167.                     until Ord4(thePtr) >= Ord4(ScrapInfo^.ScrapHandle^) + ScrapInfo^.scrapSize;
  168.                     HUnLock(ScrapInfo^.ScrapHandle);
  169.                     DrawString('] bytes in Scrap');
  170.                 end;
  171.  
  172.             if usingcolor then
  173.                 CloseCPort(@p)
  174.             else
  175.                 ClosePort(@p);
  176.             SetPort(savePort);            { restore grafport }
  177.  
  178. {•   Delay(WaitTime, Grow);            { delay to allow keys to be released •]}
  179.             repeat
  180.             until GetOSEvent(mDownMask + keyDownMask, theEvent);
  181.  
  182.             DrawMenuBar;                    { fix menubar }
  183.         end;    { main }
  184.  
  185.  
  186. {$ifc fkey = false}
  187.  
  188.     begin
  189.         main;
  190.  
  191. {$endc}
  192.  
  193.     end.